module fn.adt.tree.search.Pattern

open System.Collections.Generic
open fn.adt.Tree


type Wild<'a,'m> =
 | Literal of 'a
 | Any of 'm
 override this.ToString() = 
    match this with
    | Literal a -> a.ToString()
    | Any m -> sprintf "?%O" m

let (?) = Any

let rec check_termination (s : seq<'a option>) =
    match Seq.head s with
    | None -> None
    | x ->
        let remaining = Seq.skip 1 s
        if Seq.isEmpty remaining then x else check_termination remaining

let foldWhile (f : 'State -> 'T -> 'State option) initial s = 
    check_termination
        (Seq.scan (fun state t -> (match state with Some x -> f x t | None -> None)) (Some initial) s)
    //Seq.fold (fun state t -> (match state with Some x -> f x t | None -> None)) (Some initial) s
    //|> Seq.takeWhile (fun x -> x <> None)

let rec patmatch (pattern: Tree<Wild<'a,'m>>) (text: Tree<'a>) =
  match (pattern, text) with
  | Node (Literal x, ps), Node (y, ts) when x=y && ps.Length=ts.Length ->
     let submatches = seq { for (p,t) in (List.zip ps ts) -> patmatch p t }
     foldWhile (fun state submatch -> 
        match submatch with | Some l -> Some (List.concat [|state; l|]) | None -> None) [] submatches

  | Node (Any m, []), (Node (y, _) as ty) -> Some [(m,ty)]
  | _ -> None

(*
 * Matches two trees by starting at the root and going down. The pattern tree
 * may contain wildcards which would match against any node, any subtree, or any
 * sequence of subtrees at the given location.
 * Produces a unification of wildcards with the values actually found in the
 * input tree text.
 *)
type TreeTopPattern<'D, 'm when 'D : equality and 'm : equality> (pat: Tree<Wild<'D,'m>>) =
    class
        member this.pattern = pat
        static member inline (=~) (this: TreeTopPattern<'D,'m>, text: Tree<'D>) =
            match (patmatch (this.pattern) text) with
            | Some lst -> Some (dict lst)
            | None -> None
            
        override this.ToString() = this.pattern.ToString()
    end
        
        
        